perm filename SMOOTH.OSA[SYS,ALS] blob sn#001170 filedate 1972-07-28 generic text, type T, neo UTF8
00010	BEGIN "SMOOTH"
00020	DEFINE ⊂="COMMENT";	⊂ 7/28/72;
00030	⊂	This program analyses TABLES.DAT and smooths the output 
00031		columns for P2 and P3 tables where the total line entries
00032		 are less than 4 in any one line. It does this, line by
00033		line, by summing the input data for the four nearest or
00034		six nearest neighbors. If this sum is zero it then sums	
00042		the nearest diagonal entries and in the case of P2 tsbles
00046		it even goes on to sum the nearest once removed neighbors;
00050	
00060	REQUIRE "COMSUB.HDR[SYS,ALS]" SOURCE_FILE;
00070	
00080	DEFINE DATSIZ="1280",BUFEXS="43",BUFSIZ="1323";
00087	REQUIRE "BLOCKS.HDR[SYS,THO]" SOURCE_FILE;
00090	DEFINE CR="'15",LF="'12",TB="'11",CRLF="CR&LF";
00150	INTEGER CHAN1,CHAN2,CHAN3,CHAN4,CHAN5,CHAN6,EOF,IEOF,EOFA,BRK;
00170	INTEGER I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,INK;
00180	INTEGER INTOT;
00200	TABIN(INTOT);
00430	
00440	N←INTOT;
00450	
00480	OUTSTR(TB&"Record of smoothed entries as of "&DATIME&CRLF&LF);
00490	
00495	OUTSTR("INCNT = "&CVS(INCNT[0])&CRLF);
00605	OUTSTR("Name"&TB&"TYPE"&TB&"Learn"&TB&"Gate"&TB&"IN1"&
00607		TB&"IN2"&TB&"IN3"&TB&"IN4"&TB&"IN5"&TB&"IN6"&CRLF);
00610	FOR I←N*74 STEP 74 UNTIL TABSIZ-75 DO BEGIN
00630	IF LIST[N]≠0 THEN BEGIN IF LIST[N]≠1 THEN BEGIN "DECODE"
00635	  STRING LEARN;INTEGER K1,K2,K3,K4;
00640	    IF LIST[N+LISSIZ%10]≥CVSIX("Q0") THEN BEGIN
00650	       K←LIST[N+LISSIZ%5]; K1←K LSH -18; K2←(K LSH 18) LSH -30;
00660	       K3←(K LSH 24) LSH -30; K4←(K LSH 30) LSH -30;
00670	       LEARN←CVXSTR(PHLIST[K1])[1 TO 2]&CVXSTR(PHLIST[K2])[1 TO 2]&
00680	             CVXSTR(PHLIST[K3])[1 TO 2]&CVXSTR(PHLIST[K4])[1 TO 2];
00690						  END 
00700	          ELSE LEARN←CVXSTR(LIST[N+LISSIZ%5]);
00710	
00720	  OUTSTR(CVXSTR(LIST[N])&TB&CVXSTR(LIST[N+LISSIZ%10])&
00730	LEARN&TB&CVXSTR(LIST[N+3*LISSIZ%10])&TB&
00740	CVXSTR(LIST[N+4*LISSIZ%10])&TB&
00750	CVXSTR(LIST[N+LISSIZ%2])&TB&CVXSTR(LIST[N+6*LISSIZ%10])&TB&
00760	CVXSTR(LIST[N+7*LISSIZ%10])&TB&CVXSTR(LIST[N+8*LISSIZ%10])&TB&
00770	CVXSTR(LIST[N+9*LISSIZ%10])&CRLF); END "DECODE"; END ELSE DONE;
00775	OUTSTR(CRLF);
00777	M←P←0;
00780	
00790	IF LIST[N+LISSIZ%10]<CVSIX("Q0") THEN BEGIN
01000	
01010	K←TABLES[I+1];
01020	INK←(K LSH 6) LSH -30;
01025	SETFORMAT(1,0);
01030	
01040		⊂ **** P2 ****;
01050	IF INK=2 THEN BEGIN
01055	FOR J←0 STEP 1 UNTIL 7 DO
01065	 FOR K←0 STEP 1 UNTIL 7 DO BEGIN
01075	  L←(J LSH 3)+K+I+10;
01085	  M←TABLES[L];
01095	  IF ((M LSH 16) LSH -20)+(M LSH -20)<4 THEN BEGIN
01097	   OUTSTR("Entry "&CVS(K)&","&CVS(J)); M←M+1;P←P+1;
01100	   Q←M LSH -4;
01110	   IF K>0 THEN Q←Q+(TABLES[L-1] LSH -4);
01120	   IF K<7 THEN Q←Q+(TABLES[L+1] LSH -4);
01130	   IF J>0 THEN Q←Q+(TABLES[L-8] LSH -4);
01140	   IF J<7 THEN Q←Q+(TABLES[L+8] LSH -4);
01141	   IF Q=0 THEN BEGIN
01142	    IF K>0 THEN BEGIN IF J>0 THEN Q←Q+(TABLES[L-9] LSH -4);
01143	     IF J<7 THEN Q←Q+(TABLES[L+7] LSH -4); END;
01144	    IF K<7 THEN BEGIN IF J>0 THEN Q←Q+(TABLES[L-7] LSH -4);
01145	     IF J<7 THEN Q←Q+(TABLES[L+9] LSH -4); END;
01146	   END;
01150	   IF Q=0 THEN BEGIN
01160	    IF K>1 THEN Q←Q+(TABLES[L-2] LSH -4);
01170	    IF K<6 THEN Q←Q+(TABLES[L+2] LSH -4);
01180	    IF J>1 THEN Q←Q+(TABLES[L-16] LSH -4);
01190	    IF J<6 THEN Q←Q+(TABLES[L+16] LSH -4);
01200	   END;
01210	   IF Q≠0 THEN BEGIN
01220	    R←(Q LSH 20) LSH -20;
01230	    S← Q LSH -16;
01240	    R←(R LSH 3)%(R+S);
01250	    IF R>7 THEN R←7;
01260	    TABLES[L]←((TABLES[L] LSH -4) LSH 4)+R;
01265	    OUTSTR(" was set to "&CVS(R));
01270	   END ELSE OUTSTR(" not smoothed");
01275	   IF P=1 THEN OUTSTR(TB);
01277	   IF P=2 THEN BEGIN P←0; OUTSTR(CRLF); END;
01280	  END;
01290	 END;
01490	
01500		⊂ **** P3 ****;
01510	END ELSE IF INK=3 THEN BEGIN
01520	FOR J←0 STEP 1 UNTIL 3 DO
01536	 FOR K←0 STEP 1 UNTIL 3 DO
01544	  FOR T←0 STEP 1 UNTIL 3 DO BEGIN
01552	   L←(J LSH 4)+(K LSH 2)+T+I+10;
01568	   M←TABLES[L];
01584	   IF ((M LSH 16) LSH -20)+(M LSH -20)<4 THEN BEGIN
01600	    OUTSTR("Entry "&CVS(T)&","&CVS(K)&","&CVS(J)); M←M+1;P←P+1;
01616	    Q←M LSH -4;
01632	    IF T>0 THEN Q←Q+(TABLES[L-1] LSH -4);
01648	    IF T<3 THEN Q←Q+(TABLES[L+1] LSH -4);
01664	    IF K>0 THEN Q←Q+(TABLES[L-4] LSH -4);
01680	    IF K<3 THEN Q←Q+(TABLES[L+4] LSH -4);
01688	    IF J>0 THEN Q←Q+(TABLES[L-16] LSH -4);
01692	    IF J<3 THEN Q←Q+(TABLES[L+16] LSH -4);
01696	    IF Q=0 THEN BEGIN
01712	     IF T>0 THEN BEGIN IF K>0 THEN BEGIN
01720	       IF J>0 THEN Q←Q+(TABLES[L-16-4-1] LSH -4);
01724	       IF J<3 THEN Q←Q+(TABLES[L+16-4-1] LSH -4); END;
01726	      IF K<3 THEN BEGIN
01727	       IF J>0 THEN Q←Q+(TABLES[L-16+4-1] LSH -4);
01728	       IF J<3 THEN Q←Q+(TABLES[L+16+4-1] LSH -4); END;
01729	     IF T<3 THEN BEGIN IF K>0 THEN BEGIN
01737	       IF J>0 THEN Q←Q+(TABLES[L-16-4+1] LSH -4);
01740	       IF J<3 THEN Q←Q+(TABLES[L+16-4+1] LSH -4); END;
01746	      IF K<3 THEN BEGIN
01752	       IF J>0 THEN Q←Q+(TABLES[L-16+4+1] LSH -4);
01757	       IF J<3 THEN Q←Q+(TABLES[L+16+4+1] LSH -4); END;
01758	     END;
01760	    END;
01860	  END;
01888	   IF Q≠0 THEN BEGIN
01904	    R←(Q LSH 20) LSH -20;
01920	    S← Q LSH -16;
01936	    R←(R LSH 3)%(R+S);
01952	    IF R>7 THEN R←7;
01968	    TABLES[L]←((TABLES[L] LSH -4) LSH 4)+R;
01984	    OUTSTR(" was set to "&CVS(R));
02000	   END ELSE OUTSTR(" not smoothed");
02016	   IF P=1 THEN OUTSTR(TB);
02032	   IF P=2 THEN BEGIN P←0; OUTSTR(CRLF); END;
02048	  END;
02064	 END;
02080	
02130	END;	⊂ CHANGE TO END ELSE to add 6-input case;
02140	
02150		⊂ **** Q ****;
02160	END ELSE BEGIN	⊂ Start of Q;
02170	IF I>(TABSIZ -149) THEN  DONE;
02610	
02620	K←TABLES[I+1];
02630	K←(K LSH 6) LSH -30;
02640	
02650		⊂ **** Q2 ****;
02660	IF INK=2 THEN BEGIN
02670	
02960	  OUTSTR(CRLF);
02980	
02990		⊂ **** Q3 ****;
03000	END ELSE IF INK=3 THEN BEGIN
03010	
03285	
03900	
03910		⊂ **** Q6 ****;
03920	END ELSE IF INK=6 THEN BEGIN
03930	
04640	END;	⊂ End of INK=6;
04650	I←I+74; N←N+1;
04660	END;	⊂ End of Q;
04670	OUTSTR(CRLF);
04680	IF I>TABSIZ -75 THEN DONE;
04690	N←N+1; IF LIST[N]=0 THEN DONE; IF M>0 THEN INCHRW;
04715	IF P=1 THEN OUTSTR(CRLF);END;
04740	
04840	TABOUT;
04870	OUTSTR("TABLES.DAT has been rewritten as smoothed"&crlf);
05000	END "SMOOTH";